home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Light ROM 1
/
LIGHT-ROM 1 (Amiga Library Services)(1994).iso
/
ffdisks
/
d938.lha
/
Angie
/
ImportedModules.lha
/
CxLib.mod
< prev
next >
Wrap
Text File
|
1993-10-29
|
20KB
|
588 lines
(* ------------------------------------------------------------------------
:Program. CxLib
:Author Franz Schwarz
:Address. Mühlenstraße 2, D-78591 Durchhausen, Germany / R.F.A.
:Address. uucp: Franz.Schwarz@mil.ka.sub.org; Fido: 2:241/7506.18
:Copyright. Freeware (freely distributable, copyrighted software)
:Language. Oberon-2
:Translator. Amiga-Oberon 3.00
:Contents. Oberon-Implementation of Commodore's cx.lib
:Contents. All functions of Commodore's cx.lib are implemented.
:Support. BlackMagic
:History. 22-Jul-93 Version 1.0 fSchwarz
:History. 30-Sep-93 Version 1.0a fSchwarz adapted to OS3.0 interfaces
:History. 03-Oct-93 Version 1.0b fSchwarz now only tries once to get
:History. default arguments (due to minor problems with
:History. Dos.ReadArgs; ArgArrayInit() returns a valid ptr if the
:History. CLI commandline is empty.
:Remark. Requires OS3.0 interface modules update by hartmut Goebel
:Remark. As of Amiga Oberon Release 3.00: possible odd pointers to
:Remark. array of char/byte: _don't_ compile with OddChk
------------------------------------------------------------------------- *)
MODULE CxLib;
(****** CxLib/--overview-- **************************************************
*
* CxLib is an Oberon implementation of Commodore's
* commoditiy.library related functions in amiga.lib .
* Moreover, it offers several gimmicks that make it superior
* to Commodore's amiga.lib - functions. There is an additional
* function ArgBool() that eases handling of boolean-type
* ToolTypes, as well as an InvertStringForwd() function returning
* the InputEvents in forward order. The InvertString() function
* has some additional functionality, like the special magic RETURN
* mapping (see InvertString() documentation) and the '\xff' Hex
* esc code. This module closes a possibly open ArgArray ressource
* handle on shutdown, and correctly gains access to the program's
* arguments with ArgArrayInit() when calling the ToolType functions
* with NIL ToolType array handles, but may be flexibly used with
* different ToolType arrays by supplying valid ToolType array handles,
* too.
*
******************************************************************************)
(****** CxLib/--legal-- **************************************************
*
* LEGAL STATUS
* CxLib is Freeware, Copyright © 1993 by F.Schwarz. All Rights
* reserved. Freeware is an abbreviation for Freely Distributable
* Copyrighted Software. That means, you may freely distribute this
* software for non-profit-making purposes, and use it in your own
* freely distributable software. However if you intend to use it
* in commercial software or shareware you may only use it under the
* condition you consider me to be a registred, legitimate user of
* that software and you contact me before releasing that software.
*
* DISCLAIMER
* Liability - what liability?? In fact, no liability whatsoever is
* provided by the author of this software - this is generally known
* as "USE AT YOUR OWN RISK" - and that is exactly what it means.
*
* DISTRIBUTION
* This software may be distributed if only a _reasonable_ copying
* fee is charged apart from the consts for the media it is copied to.
* Furthermore, it may be included in Freely Distributable software
* libraries like AMOK, etc, including CD-ROM versions of them.
*
* Contact addresses for bug reports, comments, inquiries or anything else:
*
* Mühlenstraße 2, D-78591 Durchhausen, Germany / R.F.A.
* email: uucp: Franz_Schwarz@mil.ka.sub.org; Fido: 2:241/7506.18
*
*****************************************************************************)
IMPORT
e: Exec, d: Dos, km: KeyMap, kml: KeyMapLib, co: Commodities,
wb: Workbench, ic: Icon, o: OberonLib, b: BlackMagic, ie: InputEvent,
st: Strings, a: ASCII, y: SYSTEM;
VAR
ArgArrayInitTried: BOOLEAN;
dObject : wb.DiskObjectPtr;
rda : d.RDArgsPtr;
ttypes - : b.TTPtr;
EmptyArgs: b.LStrPtr; (* this is a pseudo CONST (NIL) *)
(****** CxLib/ArgArrayInit **************************************************
*
* NAME
* ArgArrayInit - get a pointer to the program's argument array
*
* SYNOPSIS
* ArgArrayInit(): BlackMagic.TTPtr
*
* FUNCTION
* Returns a pointer to the argument array no matter whether the
* program was started from CLI or Workbench. It is safe to call
* this function multiple times.
*
* RESULT
* The pointer to the NIL-terminated array of (untraced) pointers
* to the argument strings or NIL for failure.
*
* NOTES
* Due to Commodore's Dos/ReadArgs() implementation, all CLI args
* containing a '=' have to be surrounded with quotes. (i.e.
* "CX_PRIORITY=-1" instead of just CX_PRIORITY=-1)
*
* SEE ALSO
* ArgsArrayDone()
*
******************************************************************************)
PROCEDURE ArgArrayInit* (): b.TTPtr;
VAR
dir : d.FileLockPtr;
BEGIN
IF ArgArrayInitTried THEN RETURN ttypes; END;
ArgArrayInitTried := TRUE;
IF o.wbStarted THEN
dir := d.CurrentDir (o.wbenchMsg(wb.WBStartup).argList[0].lock);
dObject := ic.GetDiskObjectNew (o.wbenchMsg(wb.WBStartup).argList[0].name^);
IF dObject # NIL THEN ttypes := dObject.toolTypes; END;
dir := d.CurrentDir (dir);
ELSE (* Shell *)
IF rda = NIL THEN
rda := d.OldReadArgs ("/M", ttypes, NIL);
IF (rda # NIL) & (ttypes = NIL) THEN ttypes := y.ADR (EmptyArgs); END;
END;
END;
RETURN ttypes;
END ArgArrayInit;
(****** CxLib/ArgArrayDone **************************************************
*
* NAME
* ArgArrayDone - free the resources allocated with ArgArrayInit()
*
* SYNOPSIS
* ArgArrayDone ()
*
* FUNCTION
* ArgArrayDone frees any possible ressources that have been allocated
* by previous calls to ArgArrayInit().
*
* NOTES
* There is no need to call this function explicitely since it is
* called during CxLib's shutdown code.
*
* SEE ALSO
* ArgArrayInit()
*
****************************************************************************)
PROCEDURE ArgArrayDone *();
BEGIN
IF dObject#NIL THEN
ic.FreeDiskObject(dObject); dObject:=NIL;
ELSIF rda # NIL THEN
d.FreeArgs(rda); rda := NIL;
END;
ttypes:=NIL;
END ArgArrayDone;
(****** CxLib/ArgInt ********************************************************
*
* NAME
* ArgInt - get number stored in a specific arg or default number
*
* SYNOPSIS
* ArgInt (tt : BlackMagic.TTPtr;
* typeName : ARRAY OF CHAR;
* defaultVal: LONGINT ): LONGINT;
*
* FUNCTION
* Searches the argument array tt for a typeName-named argument,
* and returns a valid integer stored in the argument's array.
* Otherwise, defaultVal is returned.
*
* INPUTS
* tt - a valid pointer to an argument array or NIL, in
* which case the argument array returned by
* ArgArrayInit() is used.
* typeName - the argument name
* defaultVal- the default value returned in case of 'failure'
*
* RESULT
* If the argument was found, and it contained a valid dec/hex number
* char sequence, the appertaining integer representation, otherwise
* defaultVal.
*
* SEE ALSO
* ArgString(), ArgBool(), BlackMagic/StrToLong()
*
****************************************************************************)
PROCEDURE ArgInt* (tt: b.TTPtr; typeName: ARRAY OF CHAR;
defaultVal: LONGINT): LONGINT;
VAR str: e.STRPTR;
v: LONGINT;
(* $CopyArrays- *)
BEGIN
IF tt=NIL THEN tt:=ArgArrayInit(); END;
IF tt#NIL THEN
str:=ic.FindToolType(tt, typeName);
IF str#NIL THEN
IF b.StrToLong (str^, v) THEN
RETURN v
END;
END;
END;
RETURN defaultVal;
END ArgInt;
(****** CxLib/ArgString *******************************************************
*
* NAME
* ArgString - get string stored in a specific arg or default string
*
* SYNOPSIS
* ArgString (tt : BlackMagic.TTPtr;
* typeName : ARRAY OF CHAR;
* defaultStr: ARRAY OF CHAR ): BlackMagic.LongStrPtr
*
* FUNCTION
* Searches the argument array tt for a typeName-named argument,
* and returns its string. If the argument does not exist,
* defaultVal is returned.
*
* INPUTS
* tt - a valid pointer to an argument array or NIL, in
* which case the argument array returned by
* ArgArrayInit() is used.
* typeName - the argument name
* defaultStr- the default string returned in case of 'failure'
*
* RESULT
* If the argument was found, the appertaining arg string,
* otherwise defaultStr;
*
* SEE ALSO
* ArgInt(), ArgBool()
*
****************************************************************************)
PROCEDURE ArgString *(tt: b.TTPtr; typeName: ARRAY OF CHAR;
defaultStr: ARRAY OF CHAR): b.LStrPtr;
VAR str: e.APTR;
(* $CopyArrays- *)
BEGIN
IF tt=NIL THEN tt:=ArgArrayInit(); END;
IF tt#NIL THEN
str:=ic.FindToolType(tt, typeName);
IF str#NIL THEN RETURN str; END;
END;
RETURN b.StrIndex (defaultStr, 0);
END ArgString;
(****** CxLib/ArgBool *********************************************************
*
* NAME
* ArgBool - get boolean value stored in specific arg or default bool
*
* SYNOPSIS
* ArgBool (tt : BlackMagic.TTPtr;
* typeName : ARRAY OF CHAR;
* defaultBool: BOOLEAN ): BOOLEAN
*
* FUNCTION
* Searches the argument array tt for a typeName-named argument,
* and returns TRUE if the argument's value string is empty, or
* if it includes 'TRUE' / 'YES' (case-insensitive). It returns
* FALSE if the typeName-named argument was found and its value
* string is not empty and doesn't contain 'TRUE' or 'YES'. If
* the searched argument is not found, defaultBool is returned.
*
* INPUTS
* tt - a valid pointer to an argument array or NIL, in
* which case the argument array returned by
* ArgArrayInit() is used.
* typeName - the argument name
* defaultStr- the default boolean value.
*
* RESULT
* If the argument was found, the appertaining boolean value,
* otherwise defaultBool;
*
* SEE ALSO
* ArgInt(), ArgString()
*
****************************************************************************)
PROCEDURE ArgBool* (tt: b.TTPtr; typeName: ARRAY OF CHAR;
defaultBool: BOOLEAN): BOOLEAN;
VAR str: e.STRPTR;
(* $CopyArrays- *)
BEGIN
IF tt=NIL THEN tt:=ArgArrayInit(); END;
IF tt#NIL THEN
str:=ic.FindToolType(tt, typeName);
IF str#NIL THEN
IF str[0]='\000' THEN
RETURN TRUE;
ELSIF ic.MatchToolValue(str^,"YES") OR ic.MatchToolValue(str^,"TRUE") THEN
RETURN TRUE;
ELSE
RETURN FALSE;
END;
END;
END;
RETURN defaultBool;
END ArgBool;
(****** CxLib/HotKey ********************************************************
*
* NAME
* HotKey - create a triad of commodities objects for a hotkey
*
* SYNOPSIS
* HotKey (descr: ARRAY OF CHAR;
* port : Exec.MsgPortPtr;
* id : LONGINT ): Commodities.CxObjPtr
*
* FUNCTION
* This function creates a Filter-, a Sender-, and a Translate-
* CxObject and connects them so that any input event matching
* <descr> will dispatch a message to <port> with identifier
* code <id> and the input event will be removed from the input
* stream.
*
* INPUTS
* descr - the input description string for the hotkey
* port - the Exec.MsgPort that shall receive a msg
* whenever the hotkey is pressed
* id - the id code to be sent to the port with the msg.
*
* RESULT
* a valid Commodities.CxObjPtr, or NIL in case of failure.
*
* SEE ALSO
* Commodities.doc
*
****************************************************************************)
PROCEDURE HotKey* (descr: ARRAY OF CHAR; port: e.MsgPortPtr;
id: LONGINT): co.CxObjPtr;
VAR cx1: co.CxObjPtr;
(* $CopyArrays- *)
BEGIN
cx1:=co.CxFilter (b.StrIndex (descr, 0));
IF cx1#NIL THEN
co.AttachCxObj (cx1, co.CxSender (port, id));
co.AttachCxObj (cx1, co.CxTranslate (NIL));
IF co.CxObjError (cx1) = LONGSET{} THEN
RETURN cx1;
END;
co.DeleteCxObjAll (cx1);
END;
RETURN NIL;
END HotKey;
(****** CxLib/FreeIEvents *******************************************************
*
* NAME
* FreeIEvents - frees a chain of input events from InvertString()
*
* SYNOPSIS
* FreeIEvents (VAR iEvent: InputEvent.InputEventPtr);
*
* FUNCTION
* This functions frees a chain of input events allocated by
* InvertString() / InvertStringForwd()
*
* INPUTS
* iEvent - pointer to a chain of InputEvents. MUST have been
* returned from InvertString() / InvertStringForwd()
* May be NIL.
*
* RESULT
* the VAR iEvent is cleared
*
* SEE ALSO
* InvertString(), InvertStringForwd()
*
****************************************************************************)
PROCEDURE FreeIEvents* (VAR iEvent: ie.InputEventPtr);
VAR
ie1: ie.InputEventPtr;
BEGIN
WHILE iEvent#NIL DO
ie1:=iEvent; iEvent:=iEvent.nextEvent;
e.FreeVec (ie1);
END;
END FreeIEvents;
CONST
returnRawKeyCode = 44H;
retEvent = ie.InputEvent (NIL, ie.rawkey, 0, returnRawKeyCode, {}, 0, 0, 0, 0);
(****** CxLib/InvertString ******************************************************
*
* NAME
* InvertString - create chain of ievents from mixed str / IX descr
* InvertStringForwd - create chain of ievents in forward order
*
* SYNOPSIS
* InvertString (string: ARRAY OF CHAR;
* km : KeyMapPtr ): InputEvent.InputEventPtr;
*
* InvertStringForwd (string: ARRAY OF CHAR;
* km : KeyMapPtr ): InputEvent.InputEventPtr;
*
* FUNCTION
* These functions create a chain of InputEvents from a string
* consisting of normal string sequences with backslash escape
* sequences ('\\','\r','\n','\f','\e',"\'",'\"','\xff','\<','\t',
* '\0') and Commodities' input description strings enclosed in
* angled brackets ('<input desr>'). As a special bonus, this
* function always converts carriage returns from not within
* input description sequences ('<inp descr>') into RETURN_RAWKEY
* events if the return rawkey maps to carriage return. This
* functionality is not available in Commodore's amiga.lib-
* InvertString() although this is of significance for inserting
* text into many editors, as internal remapping of ENTER is quite
* frequent in that field.
*
* INPUTS
* string - the string to be converted into a chain of InputEvents
* km - the keymap to be used for converting. May be NIL in
* which case the system's current default keymap is used.
*
* RESULT
* a pointer to the first InputEvent of an InputEvent chain or NIL.
*
* NOTES
* Like Commodore's InvertString() function, InvertString() returns
* the InputEvents chained in REVERSE ORDER, ie. the resulting pointer
* points to the last InputEvent, and the first InputEvent is last
* in the list. Thus you should preferably use InvertStringForwd(),
* since that function returns the generated events in forward order,
* as its name already implies.
*
* SEE ALSO
* Commodities/ParseIX()
*
****************************************************************************)
PROCEDURE InvertString* (string: ARRAY OF CHAR; km: km.KeyMapPtr): ie.InputEventPtr;
VAR
iEvent1,iEvent2: ie.InputEventPtr;
fail : BOOLEAN;
ch : CHAR;
cb : ARRAY 1 OF CHAR;
str : b.LStrPtr;
remapret : BOOLEAN;
PROCEDURE DoAngle(): BOOLEAN;
VAR
tempstr: b.DynStrPtr;
l : LONGINT;
ix : co.IXPtr;
r : BOOLEAN;
(* $CopyArrays- *)
BEGIN
tempstr := NIL; ix := NIL;
l:=0; r:=FALSE;
WHILE (str[l] # '\000') & (str[l] # '>') DO INC(l); END;
IF str[l] # '\000' THEN
IF b.DynExpand (tempstr, l) THEN
st.Cut (str^, 0, l, tempstr^);
ix:=e.AllocVec (SIZE (co.IX), LONGSET{e.memClear,e.public});
IF ix # NIL THEN
str := b.StrIndex (str^, l);
IF co.ParseIX (tempstr^,ix^) # 0 THEN
y.SETREG (0, d.SetIoErr (d.objectWrongType));
ELSE
iEvent2.class := ix.class;
iEvent2.code := y.VAL(INTEGER,ix.code);
iEvent2.qualifier := ix.qualifier;
r:=TRUE;
END;
END;
END;
END;
IF ix # NIL THEN e.FreeVec (ix); END;
IF tempstr # NIL THEN DISPOSE (tempstr); END;
RETURN r;
END DoAngle;
PROCEDURE DoEsc (): LONGINT;
VAR
c: CHAR;
n: LONGINT;
BEGIN
CASE CAP (str[1]) OF
'\"','\'','<','\\': ch := str[1]; RETURN 1; |
'0': ch := a.nul; RETURN 1; |
'N','R': ch := a.cr; RETURN 1; |
'F': ch := a.ff; RETURN 1; |
'T': ch := a.ht; RETURN 1; |
'X':
c := CAP (str[2]);
CASE c OF '0'..'9', 'A'..'F':
n := ORD (c) - ORD ('0');
CASE c OF 'A'..'F': n := n + 10 + ORD ('0') - ORD ('A'); ELSE END;
c := CAP (str[3]);
CASE c OF '0'..'9', 'A'..'F':
n := n * 16 + ORD (c) - ORD ('0');
CASE c OF 'A'..'F': n := n + 10 + ORD ('0') - ORD ('A'); ELSE END;
ch := CHR (n); RETURN 3;
ELSE END;
ch := CHR (n); RETURN 2;
ELSE END;
ELSE END;
ch := '\\'; RETURN 0;
END DoEsc;
(* $CopyArrays- *)
BEGIN
iEvent1 := NIL; iEvent2 := NIL; remapret := FALSE;
IF kml.base # NIL THEN IF kml.MapRawKey (y.ADR (retEvent), cb, 1, km) = 1 THEN
remapret := cb[0] = a.cr (* is carriage return mapped to rawkey code RETURN ? *)
END; END;
str := b.StrIndex (string, 0);
LOOP
fail := FALSE;
iEvent1 := NIL;
IF ORD (str[0]) = 0 THEN RETURN NIL; END;
REPEAT
iEvent2 := e.AllocVec (SIZE (ie.InputEvent), LONGSET{e.memClear,e.public});
IF iEvent2 = NIL THEN fail := TRUE; EXIT; END;
ch := str[0];
IF (ch = '<') & (str[1] # a.nul) THEN
str := b.StrIndex (str^, 1);
IF ~DoAngle () THEN fail := TRUE; EXIT; END;
ELSE
CASE ch OF '\\':
str := b.StrIndex (str^, DoEsc ());
ELSE END;
CASE ch OF a.lf: ch := a.cr; ELSE END;
IF (ch = a.cr) & remapret THEN (* cr magic *)
iEvent2^ := retEvent;
ELSE
IF ~co.InvertKeyMap (ORD (ch), iEvent2, km) THEN
y.SETREG (0, d.SetIoErr (d.objectWrongType)); fail := TRUE; EXIT;
END;
END;
END;
str := b.StrIndex (str^, 1);
iEvent2.nextEvent := iEvent1;
iEvent1 := iEvent2; iEvent2 := NIL;
UNTIL str[0] = '\000';
EXIT;
END;
IF fail THEN FreeIEvents (iEvent1); FreeIEvents (iEvent2); RETURN NIL; END;
RETURN iEvent1;
END InvertString;
PROCEDURE InvertStringForwd* (str: ARRAY OF CHAR; km: km.KeyMapPtr):
ie.InputEventPtr;
VAR
ie1,ie2,ie3,ie4: ie.InputEventPtr;
(* $CopyArrays- *)
BEGIN
ie1:=InvertString(str, km);
IF ie1#NIL THEN
ie4:=ie1; ie3:=ie1.nextEvent;
WHILE ie3#NIL DO ie2:=ie1; ie1:=ie3; ie3:=ie1.nextEvent; ie1.nextEvent:=ie2; END;
ie4.nextEvent:=NIL;
END;
RETURN ie1;
END InvertStringForwd;
BEGIN
CLOSE
ArgArrayDone();
END CxLib.